perm filename DATUM.SAI[PUB,TES]1 blob
sn#129299 filedate 1974-11-07 generic text, type T, neo UTF8
00100 BEGOF("DATUM")
00200
00300 IFC PASSONE THENC
00400
00500 COMMENT
00600
00700 DAN SWINEHART'S EXPANDABLE ARRAY PACKAGE
00800
00900 Declares
01000 IDA ← [S]CREATE(LOWBND, HIGHBND) to create a (string or) integer array
01100 MAKEBE(IDA,ALIAS) to give its descriptor to array ALIAS
01200 IDA ← [S]WHATIS(ALIAS) to take it back
01300 GOAWAY(IDA) to destroctulate it
01400 IDA ← [S]BIGGER(IDA,XTRA) to add XTRA words to its length.
01500
01600 PLUS some of our own functions to PUSH records onto stacks and to PUT
01700 records onto heaps (herein called TBLs).
01800
01900 ;
02000
02100 ENDC
02200
02300 EXTERNAL INTEGER GOGTAB ;
02400
02500 PROCEDURES
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE DATUM! ;$"#
00300 BEGIN "DATUM!"
00400 WISTK←WHATIS(ISTK) ; WITBL←WHATIS(ITBL) ; WINEST←WHATIS(INEST) ;
00500 WSSTK←SWHATIS(SSTK) ; WSTBL←SWHATIS(STBL) ; WSNEST←SWHATIS(SNEST) ;
00600 WSYM←SWHATIS(SYM) ; WNUMBER←WHATIS(NUMBER) ; WOLDPAGE←WHATIS(OLDPAGE) ;
00700 WNEWPAGE←WHATIS(NEWPAGE) ; WTHISFRAME←WHATIS(THISFRAME);
00800 WMOLES←WHATIS(MOLES) ; WOWLS←WHATIS(OWLS) ; WNMOLES←WHATIS(NMOLES) ;
00900 WNOWLS←WHATIS(NOWLS) ; WTHISAREA←WHATIS(THISAREA) ; WWAITBOX←WHATIS(WAITBOX) ;
01000 WAVAILREC←WHATIS(AVAILREC) ; WAA←WHATIS(AA) ; WNAA←WHATIS(NAA) ;
01100 WSHORT←WHATIS(SHORT) ; WNSHORT←WHATIS(NSHORT) ;
01150 WMLEAD←WHATIS(MLEAD) ; WNMLEAD←WHATIS(NMLEAD) ; TES 11/2/74 ;
01200 ITBLIDA ← RH(CREATE(0, ITSIZE)) ; ISTKIDA ← RH(CREATE(0, ISIZE)) ; INESTIDA ← RH(CREATE(0, SIZE)) ;
01300 STBLIDA ← RH(SCREATE(0, STSIZE)) ; SSTKIDA ← RH(SCREATE(0, SSIZE)) ; SNESTIDA ← RH(SCREATE(0, SIZE)) ;
01400 SYMIDA ← RH(SCREATE(-1, SYMNO)) ; NUMBIDA ← RH(CREATE(-1, SYMNO)) ;
01500 MAKEBE(ITBLIDA, ITBL) ; MAKEBE(ISTKIDA, ISTK) ; MAKEBE(INESTIDA, INEST) ;
01600 SMAKEBE(STBLIDA, STBL) ; SMAKEBE(SSTKIDA, SSTK) ; SMAKEBE(SNESTIDA, SNEST) ;
01700 SMAKEBE(SYMIDA, SYM) ; MAKEBE(NUMBIDA, NUMBER) ;
01800 LAST ← IHED ← SHED ← IHIGH ← SHIGH ← 0 ; comment Tops of Stacks;
01900 OLDPGIDA←NEWPGIDA←FRAMEIDA←
01950 MOLESIDA←MLEADIDA←SHORTIDA←OWLSIDA←
01975 AREAIDA←WBOXIDA←STATUS←AREAIXM←0 ;
02000 END "DATUM!" ;
02100 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE FINIDATUM ;$"#
00300 BEGIN "FINIDATUM"
00400 FOR J ← ITBLIDA, ISTKIDA, INESTIDA, NUMBIDA DO GOAWAY(J) ;
00500 FOR J ← STBLIDA, SSTKIDA, SNESTIDA, SYMIDA DO GOAWAY(-1 LSH 18 + J) ;
00600 FOR J ← 1 THRU 35 DO IF FNTFIL[J] NEQ 0 THEN GOAWAY(FNTFIL[J]) ;
00700
00800 MAKEBE(WCW,CW);
00900 MAKEBE(WISTK, ISTK) ; MAKEBE(WITBL, ITBL) ; MAKEBE(WINEST, INEST) ;
01000 SMAKEBE(WSSTK, SSTK) ; SMAKEBE(WSTBL, STBL) ; SMAKEBE(WSNEST, SNEST) ;
01100 SMAKEBE(WSYM, SYM) ; MAKEBE(WNUMBER, NUMBER) ; MAKEBE(WOLDPAGE, OLDPAGE) ;
01200 MAKEBE(WNEWPAGE, NEWPAGE) ; MAKEBE(WTHISFRAME,THISFRAME);
01300 MAKEBE(WMOLES, MOLES) ; MAKEBE(WOWLS, OWLS) ; MAKEBE(WNMOLES, NMOLES) ;
01400 MAKEBE(WSHORT, SHORT) ; MAKEBE(WNSHORT, NSHORT) ;
01450 MAKEBE(WMLEAD, MLEAD) ; MAKEBE(WNMLEAD, NMLEAD) ; TES 11/2/74 ;
01500 MAKEBE(WNOWLS, NOWLS) ; MAKEBE(WTHISAREA, THISAREA) ; MAKEBE(WWAITBOX, WAITBOX) ;
01600 MAKEBE(WAVAILREC, AVAILREC) ; MAKEBE(WAA, AA) ; MAKEBE(WNAA, NAA) ;
01700 END "FINIDATUM" ;
01800 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER PROCEDURE BIGGER(INTEGER PTR,HM) ;$"#
00300 BEGIN "BIGGER"
00400 INTEGER PT,L,U,OLDXIDA,NEWXIDA;
00500 INTEGER ARRAY OLDX,NEWX[0:ONE];
00600 OLDXIDA←WHATIS(OLDX);
00700 NEWXIDA←WHATIS(NEWX);
00800 MAKEBE(PTR,OLDX);
00900 L←ARRINFO(OLDX,1);
01000 U←ARRINFO(OLDX,2);
01100 PT←LRMAK(L,U+HM,1);
01200 MAKEBE(PT,NEWX);
01300 ARRTRAN(NEWX,OLDX);
01400 MAKEBE(OLDXIDA,OLDX);
01500 MAKEBE(NEWXIDA,NEWX);
01600 GOAWAY(PTR);
01700 RETURN(PT);
01800 END "BIGGER";
01900 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER PROCEDURE BIGGR2(INTEGER PTR,HM) ;$"#
00300 BEGIN "BIGGR2"
00400 INTEGER PT,L,U,OLDXIDA,NEWXIDA;
00500 INTEGER ARRAY OLDX,NEWX[1:ONE,0:ONE];
00600 OLDXIDA←WHATIS(OLDX);
00700 NEWXIDA←WHATIS(NEWX);
00800 MAKEBE(PTR,OLDX);
00900 L←ARRINFO(OLDX,1);
01000 U←ARRINFO(OLDX,2);
01100 PT ← CREATE2(L,U, ARRINFO(OLDX,3), HM+ARRINFO(OLDX,4)) ;
01200 MAKEBE(PT,NEWX);
01300 ARRTRAN(NEWX,OLDX);
01400 MAKEBE(OLDXIDA,OLDX);
01500 MAKEBE(NEWXIDA,NEWX);
01600 GOAWAY(PTR);
01700 RETURN(PT);
01800 END "BIGGR2";
01900 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER SIMPLE PROCEDURE CREATE2(INTEGER LB1, UB1, LB2, UB2) ;$"#
00300 BEGIN "CREATE2"
00400 EXTERNAL INTEGER PROCEDURE LRMAK(INTEGER LB1,UB1,LB2,UB2,D) ;
00500 START!CODE MOVE '15, GOGTAB END ; COMMENT LRCOP BUG ;
00600 RETURN(LRMAK(LB1, UB1, LB2, UB2, 2)) ;
00700 END "CREATE2" ;
00800 ENDC
00100 IFK PASSONE OR PASSTWO THENK
00200 PUBLIC SIMPLE PROCEDURE GOAWAY(INTEGER I) ;$"#
00300 BEGIN COMMENT Be SURE Left Half is -1 for String Arrays! ;
00400 START!CODE MOVE '15, GOGTAB END ;
00500 IF LH(I) THEN
00600 START!CODE "SARID"
00700 HRRZ 1, I ; MOVE 1, 0(1) ; COMMENT [PREV,,NEXT] ;
00800 HLRZ 2, 1 ; HRRM 1, 0(2) ; COMMENT PREV ← [...,,NEXT] ;
00900 HRRZ 2, 1 ; SKIPE 2 ; HLLM 1, 0(2) ; COMMENT NEXT←[PREV,,...] ;
01000 END "SARID" ;
01100 ARYEL(I) ;
01200 END "GOAWAY" ;
01300 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE GROW(REFERENCE INTEGER ARRAY ARR; REFERENCE INTEGER IDA,WDS;
00300 INTEGER EXTRA; STRING WHY) ;$"#
00400 BEGIN "GROW"
00500 IDA ← RH(BIGGER(WHATIS(ARR),EXTRA)); WDS ← WDS + EXTRA ;
00600 IF WDS GEQ TWO(14) THEN WARN(NULL,"Table grown to 2↑14 entries. Utterly unmanageable. Goodbye!") ;
00700 END "GROW" ;
00800 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER SIMPLE PROCEDURE PUSHI(INTEGER WDS, TYP) ;$"#
00300 BEGIN "PUSHI"
00400 INTEGER QI ;
00500 IF (IHED ← IHED + WDS+1) > ISIZE THEN
00600 BEGIN
00700 GROW(ISTK, ISTKIDA, ISIZE, 1000, NULL) ;
00800 MAKEBE(ISTKIDA,ISTK)
00900 END ;
01000 ISTK[IHED] ← TYP ROT -9 LOR (IHED-WDS-1) ;
01100 ZEROWORDS(WDS, ISTK[IHED-WDS]) ; RETURN(IHED) ;
01200 END "PUSHI" ;
01300 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER SIMPLE PROCEDURE PUSHS(INTEGER WDS; STRING FIRST) ;$"#
00300 BEGIN"PUSHS"
00400 INTEGER QI ;
00500 IF (SHED ← SHED + WDS) > SSIZE THEN
00600 BEGIN
00700 SGROW(SSTK, SSTKIDA, SSIZE, 200, NULL) ;
00800 SMAKEBE(SSTKIDA,SSTK) ; ZEROSTRINGS(200, SSTK[SSIZE-199]) ;
00900 END ;
01000 SSTK[SHED] ← FIRST ;
01100 FOR QI←WDS-1 DOWN 1 DO SSTK[SHED-QI]←NULL ; RETURN(SHED) ;
01200 END "PUSHS" ;
01300 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER SIMPLE PROCEDURE PUTI(INTEGER WDS, FIRST) ;$"#
00300 BEGIN"PUTI"
00400 INTEGER QI ;
00500 IF (IHIGH ← IHIGH + WDS) > ITSIZE THEN
00600 BEGIN
00700 GROW(ITBL, ITBLIDA, ITSIZE, 300, NULL) ;
00800 MAKEBE(ITBLIDA,ITBL) ;
00900 END ;
01000 ITBL[IHIGH] ← FIRST ;
01100 ZEROWORDS(WDS-1, ITBL[IHIGH-WDS+1]) ; RETURN(IHIGH) ;
01200 END "PUTI" ;
01300 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER SIMPLE PROCEDURE PUTS(STRING VAL) ;$"#
00300 BEGIN"PUTS"
00400 INTEGER QI ;
00500 IF (SHIGH ← SHIGH + 1) > STSIZE THEN
00600 BEGIN
00700 SGROW(STBL, STBLIDA, STSIZE, 200, NULL) ;
00800 SMAKEBE(STBLIDA,STBL) ; ZEROSTRINGS(200, STBL[STSIZE-199]) ;
00900 END ;
01000 STBL[SHIGH] ← VAL ;
01100 RETURN(SHIGH) ;
01200 END "PUTS" ;
01300 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER PROCEDURE SBIGGER(INTEGER PTR,HM) ;$"#
00300 BEGIN "SBIGGER"
00400 EXTERNAL INTEGER PROCEDURE ARRINFO(STRING ARRAY S; INTEGER I);
00500 EXTERNAL PROCEDURE ARRTRAN(STRING ARRAY S1,S2);
00600 INTEGER PT,L,U,SOLDIDA,SNEWIDA;
00700 STRING ARRAY SOLD,SNEW[0:ONE];
00800 SOLDIDA←SWHATIS(SOLD);
00900 SNEWIDA←SWHATIS(SNEW);
01000 SMAKEBE(PTR,SOLD);
01100 L←ARRINFO(SOLD,1);
01200 U←ARRINFO(SOLD,2);
01300 PT←LRMAK(L,U+HM,-1 LSH 18 + 1);
01400 SMAKEBE(PT,SNEW);
01500 ARRTRAN(SNEW,SOLD);
01600 MAKEBE(SOLDIDA,SOLD);
01700 MAKEBE(SNEWIDA,SNEW);
01800 GOAWAY(PTR);
01900 RETURN(PT);
02000 END "SBIGGER";
02100 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER SIMPLE PROCEDURE SCREATE(INTEGER LB1, UB1) ;$"#
00300 BEGIN "SCREATE"
00400 INTEGER IDA ;
00500 START!CODE MOVE '15, GOGTAB END ;
00600 IDA ← LRMAK(LB1, UB1, -1 LSH 18 + 1) ;
00700 RETURN(IDA) ;
00800 END "SCREATE" ;
00900 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE SGROW(REFERENCE STRING ARRAY ARR; REFERENCE INTEGER IDA,WDS ;
00300 INTEGER EXTRA; STRING WHY) ;$"#
00400 BEGIN "SGROW"
00500 IDA ← RH(SBIGGER(SWHATIS(ARR),EXTRA)); WDS ← WDS + EXTRA ;
00600 IF WDS GEQ TWO(14) THEN WARN(NULL,"Table grown to 2↑14 entries. Utterly unmanageable. Goodbye!") ;
00700 END "SGROW" ;
00800 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER SIMPLE PROCEDURE SWHATIS(STRING ARRAY A) ;$"#
00300 START!CODE "SWHATIS"
00400 MOVE 1,A;
00500 END "SWHATIS";
00600 ENDC
00100 IFK PASSONE OR PASSTWO THENK
00200 PUBLIC INTEGER SIMPLE PROCEDURE WHATIS(INTEGER ARRAY A) ;$"#
00300 START!CODE "WHATIS"
00400 MOVE 1,A;
00500 END "WHATIS";
00600 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE ZEROSTRINGS(INTEGER STRS; REFERENCE STRING LOCN) ;$"#
00300 BEGIN
00400 START!CODE "ZOS"
00500 LABEL DUN ;
00600 SKIPG 1, STRS ;
00700 JRST DUN ; COMMENT NO STRS TO ZERO -- QUIT ;
00800 ADD 1, 1 ; COMMENT TWO WORDS PER STRING ;
00900 HRRZ 2, -1('17) ; COMMENT LOCN ;
01000 SUBI 2, 1 ; COMMENT POINT TO COUNT WORD FIRST ;
01100 SETZM 0(2) ;
01200 ADDI 1, -1(2) ;
01300 HRL 2, 2 ;
01400 ADDI 2, 1 ;
01500 BLT 2, (1) ;
01600 DUN:
01700 END ;
01800 END "ZEROSTRINGS" ;
01900 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE ZEROWORDS(INTEGER WDS; REFERENCE INTEGER LOCN) ;$"#
00300 BEGIN "ZEROWORDS"
00400 START!CODE "ZOT"
00500 LABEL DUN ;
00600 SKIPG 1, WDS ;
00700 JRST DUN ; COMMENT NO WDS TO ZERO -- QUIT ;
00800 HRRZ 2, -1('17) ; COMMENT LOCN ;
00900 SETZM 0(2) ;
01000 CAIN 1, 1 ;
01100 JRST DUN ; COMMENT ONLY 1 -- DON'T BLT ! ;
01200 ADDI 1, -1(2) ;
01300 HRL 2, 2 ;
01400 ADDI 2, 1 ;
01500 BLT 2, (1) ;
01600 DUN:
01700 END ;
01800 END "ZEROWORDS" ;
01900 ENDC
00100 IFK PASSONE THENK
00200
00300 FINISHED
00400
00500 ENDOF("DATUM")
00600
00700 ENDC